home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_2 / areuh.tar / areuh / linker / exp.c < prev    next >
C/C++ Source or Header  |  1990-10-10  |  16KB  |  635 lines
  1. /*
  2.  * Authors :
  3.  *   Pierre DAVID (pda@masi.ibp.fr or pda@frunip62.bitnet)
  4.  *   Janick TAILLANDIER
  5.  *
  6.  * This program can be freely used or distributed as long as this
  7.  * note is kept.
  8.  *
  9.  * This program is provided "as is".
  10.  */
  11.  
  12. /******************************************************************************
  13.  
  14.                                 TITAN ASSEMBLER
  15.  
  16.                              EXPRESSION EVALUATION
  17.  
  18.  
  19. calc_expression, reduce_E, reduce_T, reduce_F, reduce_B, reduce_X,
  20. reduce_P, dec_value, hex_value, bin_value, ascii_value, label_value, apply,
  21. trunc, next_char, append_extexp
  22.  
  23. ******************************************************************************/
  24.  
  25. #include "flag.h"
  26.  
  27. #if ASSEMBLER
  28. #include "aglobal.h"
  29. #else
  30. #include "lglobal.h"
  31. #endif
  32.  
  33. uchar extexp [4*MAXLEN] ;
  34. uchar *pexp, *pextexp ;
  35. uchar *xlabel ;
  36. int relabs ;
  37.  
  38. extern saddr symbol_value() ;
  39.  
  40. saddr reduce_E(), reduce_T(), reduce_F(), reduce_B(), reduce_X(), reduce_P(),
  41.       dec_value(), hex_value(), bin_value(), ascii_value(), label_value(),
  42.       apply(), trunc() ;
  43. void next_char(), append_extexp() ;
  44.  
  45.  
  46. /******************************************************************************
  47.  
  48.                                CALC_EXPRESSION
  49.  
  50.  
  51. synopsis : saddr calc_expression (exp)
  52.            uchar *exp
  53. description : That's the expression evaluator. Productions used are :
  54.  
  55.     E -> T { {+|-} T }*
  56.     T -> F { {*|/} F }*
  57.     F -> B { {&|!} B }*
  58.     B -> X | -X | `X           (two's and one's complement)
  59.     X -> N { {~|^} N }*
  60.     P -> D | #<hex> | %<bin> | '<ascii>' | \<ascii>\ | <label> | * | (E)
  61.  
  62.     D -> <dec>                 if expression evaluated by ASSSEMBLER
  63.     D -> <dec> | <dec> r       if expression evaluated by LINKER
  64.  
  65.     where   E : expression
  66.             T : term
  67.             F : factor
  68.             B : boolean
  69.             X : exponentiation
  70.             P : primary
  71.             D : decimal number
  72. warning : with this grammar, 5--5 is valid (5 minus -5), but 5---5 is not.
  73.           This can be modified by : B -> -B | P . The code is more complex,
  74.           and I'm not sure that it's a real improvement.
  75. note : Algorithm used is recursive descent (Mr Vermeulen would be horrified !)
  76.        like Forth/Assembler rom based assembler, but is quietly different...
  77.  
  78. ******************************************************************************/
  79.  
  80. saddr calc_expression (exp)
  81. uchar *exp;
  82. {
  83.     saddr val;
  84.  
  85.     pextexp = extexp ;
  86.     pexp = exp ;
  87.     val = reduce_E() ;
  88.     if (((val>=0L)||(val==EXP_EXT))&&(*pexp!=EOL)&&(*pexp!=' ')&&(*pexp!='\t'))
  89.     {
  90.         error(WRNEXP, "") ;    /* illegal expression */
  91.         val = EXP_ERR ;
  92.     }
  93.     *pextexp = EOL ;
  94.     return (val) ;
  95. }
  96.  
  97.  
  98. /******************************************************************************
  99.  
  100.                                    REDUCE_E
  101.  
  102.  
  103. synopsis : saddr reduce_E()
  104. description : This function reduces a given expression starting at pexp.
  105.  
  106. ******************************************************************************/
  107. saddr reduce_E()
  108. {
  109.     saddr val1, val2;
  110.     uchar op, lrelabs;
  111.  
  112.     val1 = reduce_T () ;
  113.  
  114.     while ((((op = *pexp)=='+')||(op=='-'))&&(val1!=EXP_ERR))
  115.     {
  116.         lrelabs = relabs ;
  117.         next_char () ;
  118.         val2 = reduce_T () ;
  119.         val1 = apply (val1, op, val2, lrelabs, relabs) ;
  120.     }
  121.     return (val1) ;
  122. }
  123.  
  124.  
  125. /******************************************************************************
  126.  
  127.                                    REDUCE_T
  128.  
  129.  
  130. synopsis : saddr reduce_T ()
  131. description : same as above, for T-production
  132.  
  133. ******************************************************************************/
  134.  
  135. saddr reduce_T ()
  136. {
  137.     saddr val1, val2 ;
  138.     uchar op, lrelabs ;
  139.  
  140.     val1 = reduce_F () ;
  141.     while ((((op = *pexp)=='*')||(op=='/'))&&(val1!=EXP_ERR))
  142.     {
  143.         lrelabs = relabs ;
  144.         next_char () ;
  145.         val2 = reduce_F () ;
  146.         val1 = apply (val1, op, val2, lrelabs, relabs) ;
  147.     }
  148.     return (val1) ;
  149. }
  150.  
  151.  
  152. /******************************************************************************
  153.  
  154.                                    REDUCE_F
  155.  
  156.  
  157. synopsis : saddr reduce_F ()
  158. description : same as reduce_E
  159.  
  160. ******************************************************************************/
  161.  
  162. saddr reduce_F ()
  163. {
  164.     saddr val1, val2;
  165.     uchar op, lrelabs ;
  166.  
  167.     val1 = reduce_B () ;
  168.     while ((((op = *pexp)=='&')||(op=='!'))&&(val1!=EXP_ERR))
  169.     {
  170.         lrelabs = relabs ;
  171.         next_char () ;
  172.         val2 = reduce_B () ;
  173.         val1 = apply (val1, op, val2, lrelabs, relabs) ;
  174.     }
  175.     return (val1) ;
  176. }
  177.  
  178.  
  179. /******************************************************************************
  180.  
  181.                                    REDUCE_B
  182.  
  183.  
  184. synopsis : saddr reduce_B ()
  185. description : reduces a boolean factor. This must be done by reduction of minus
  186.               sign eventually.
  187.  
  188. ******************************************************************************/
  189.  
  190. saddr reduce_B ()
  191. {
  192.     saddr val;
  193.     uchar op ;
  194.  
  195.     op = *pexp ;
  196.  
  197.     if ((op=='-')||(op=='\`')) next_char () ;
  198.     val = reduce_X () ;
  199.     if (val<0L)
  200.         return(val) ;
  201.     switch (op)
  202.     {
  203.         case '-' :
  204.             return (trunc (-val)) ;
  205.         case '\`' :
  206.             return (trunc (~val)) ;
  207.         default :
  208.             return (val) ;
  209.     }
  210. }
  211.  
  212.  
  213. /******************************************************************************
  214.  
  215.                                    REDUCE_X
  216.  
  217.  
  218. synopsis : saddr reduce_X ()
  219. description : same as reduce_E
  220.  
  221. ******************************************************************************/
  222.  
  223. saddr reduce_X ()
  224. {
  225.     saddr val1, val2;
  226.     uchar op, lrelabs;
  227.  
  228.     val1 = reduce_P () ;
  229.     while ((((op = *pexp)=='~')||(op=='^'))&&(val1!=EXP_ERR))
  230.     {
  231.         lrelabs = relabs ;
  232.         next_char () ;
  233.         val2 = reduce_P () ;
  234.         val1 = apply (val1, op, val2, lrelabs, relabs) ;
  235.     }
  236.     return (val1) ;
  237. }
  238.  
  239.  
  240. /******************************************************************************
  241.  
  242.                                    REDUCE_P
  243.  
  244.  
  245. synopsis : saddr reduce_P ()
  246. description : these are the terminal rules.
  247. note : rule P -> D is implemented "in line" in this code (not as a separate
  248.   function).
  249.  
  250. ******************************************************************************/
  251.  
  252. saddr reduce_P ()
  253. {
  254.     saddr val ;
  255.     uchar limit, line[MAXLEN] ;
  256.  
  257.     switch (*pexp)
  258.     {
  259.         case '#' :
  260.             next_char () ;
  261.             if (((*pexp>='0')&&(*pexp<='9')) ||
  262.                ((*pexp>='A')&&(*pexp<='F')) ||
  263.                ((*pexp>='a')&&(*pexp<='f')))
  264.                 val = hex_value () ;
  265.             else
  266.             {
  267.                 error (WRNIHX,"");          /* illegal hexadecimal constant */
  268.                 val = EXP_ERR ;
  269.             }
  270.             relabs = LABS ;
  271.             break ;
  272.         case '%' :
  273.             next_char () ;
  274.             if ((*pexp=='0')||(*pexp=='1'))
  275.                 val = bin_value () ;
  276.             else
  277.             {
  278.                 error (WRNIBC, "") ;        /* illegal binary constant */
  279.                 val = EXP_ERR ;
  280.             }
  281.             relabs = LABS ;
  282.             break ;
  283.         case '\'' :
  284.         case '\\' :
  285.             limit = *pexp ;
  286.             next_char () ;
  287.             val = ascii_value (limit) ;
  288.             if (*pexp!=limit)
  289.             {
  290.                 error (WRNASC,"");                 /* illegal ascii constant */
  291.                 val = EXP_ERR ;
  292.             }
  293.             next_char () ;
  294.             relabs = LABS ;
  295.             break ;
  296.         case '*' :
  297.             val = pc ;
  298.             pexp++ ;
  299.             sprintf (line, "%ldr", pc) ;
  300.             relabs = LREL ;
  301.             append_extexp (line) ;
  302.             break ;
  303.         case '(' :
  304.             next_char () ;
  305.             val = reduce_E () ;
  306.             if ((*pexp!=')')&&(val>=0))
  307.             {
  308.                 error (WRNPAR, "") ;         /* mismatched parenthesis */
  309.                 val = EXP_ERR ;
  310.             }
  311.             next_char () ;
  312.             break ;
  313.         case EOL :
  314.             error (WRNEXP,"") ;              /* illegal expression     */
  315.             val = EXP_ERR ;
  316.             break ;
  317.  
  318.         default :
  319.             if ((*pexp>='0')&&(*pexp<='9'))
  320.             {
  321.                 val = dec_value () ;
  322.                 relabs = LABS ;
  323. #if LINKER
  324.                 if (*pexp=='r')
  325.                 {
  326.                     next_char() ;
  327.                     relabs = LREL ;
  328.                     val += tmodule[file].m_ad ;
  329.                 }
  330. #endif
  331.             }
  332.             else val = label_value () ;
  333.             break ;
  334.     }
  335.     return (val) ;
  336. }
  337.  
  338.  
  339. /******************************************************************************
  340.  
  341.                                    DEC_VALUE
  342.  
  343.  
  344. synopsis : saddr dec_value ()
  345. descrption : This function returns the decimal value of a constant. The search
  346.              is stopped when a non numeric digit is reached.
  347.              (this can be ),+,-,*,/,&,!).
  348.              Finally, the founded value is returned.
  349. note : this function doesn't check overflow. If there is, numbers are treated
  350.        as 20 bits words, and overflow doesn't propagate on 32 bits of an
  351.        integer (-1 is never reached when calculus).
  352.  
  353. ******************************************************************************/
  354.  
  355. saddr dec_value ()
  356. {
  357.     saddr val=0L ;
  358.  
  359.     do
  360.     {
  361.         val = trunc (val * 10L + (saddr) (*pexp-'0') ) ;
  362.         next_char () ;
  363.     }
  364.     while ((*pexp>='0')&&(*pexp<='9')) ;
  365.     return (val);
  366. }
  367.  
  368.  
  369. /******************************************************************************
  370.  
  371.                                    HEX_VALUE
  372.  
  373.  
  374. synopsis : saddr hex_value ()
  375. description : same as above for hexadecimal constants
  376.  
  377. ******************************************************************************/
  378.  
  379. saddr hex_value ()
  380. {
  381.     saddr i, val = 0L ;
  382.  
  383.     while ( ((*pexp>='0')&&(*pexp<='9')) ||
  384.             ((*pexp>='A')&&(*pexp<='F')) ||
  385.             ((*pexp>='a')&&(*pexp<='f')) )
  386.     {
  387.         if (*pexp<='9') i = (long int) ((*pexp) - '0') ;
  388.         else if (*pexp<='F') i = (long int) ((*pexp) - 'A' + 10) ;
  389.         else i = (long int) ((*pexp) - 'a' + 10) ;
  390.         val = trunc (val*16L +  i) ;
  391.         next_char () ;
  392.     }
  393.     return (val) ;
  394. }
  395.  
  396.  
  397. /******************************************************************************
  398.  
  399.                                    BIN_VALUE
  400.  
  401.  
  402. synopsis : saddr bin_value ()
  403. description : same as above for binary constants
  404.  
  405. ******************************************************************************/
  406.  
  407. saddr bin_value ()
  408. {
  409.     saddr val = 0L ;
  410.  
  411.     while ((*pexp=='0')||(*pexp=='1'))
  412.     {
  413.         val = trunc (val*2L + ((saddr) ((*pexp) - '0'))) ;
  414.         next_char () ;
  415.     }
  416.     return (val) ;
  417. }
  418.  
  419.  
  420. /******************************************************************************
  421.  
  422.                                   ASCII_VALUE
  423.  
  424.  
  425. synopsis : saddr ascii_value ()
  426. description : same as above, but the search is stopped when encoutered a '.
  427.               The pointer *pexp stands on this character.
  428.  
  429. ******************************************************************************/
  430.  
  431. saddr ascii_value (limit)
  432. uchar limit ;
  433. {
  434.     saddr val = 0 ;
  435.  
  436.     while ((*pexp!=EOL)&&(*pexp!=limit))
  437.     {
  438.         val = trunc (val*256L + ((saddr) *pexp)) ;
  439.         next_char () ;
  440.     }
  441.     return (val) ;
  442. }
  443.  
  444.  
  445. /******************************************************************************
  446.  
  447.                                   LABEL_VALUE
  448.  
  449.  
  450. synopsis : saddr label_value ()
  451. description : parses the symbol, then tries to return the value founded in the
  452.               symbol list.
  453.  
  454. ******************************************************************************/
  455.  
  456. saddr label_value ()
  457. {
  458.     uchar label[LBLLEN+2], *plabel ;
  459.     int mx, need_par = 0, j = 0 ;
  460.     saddr val ;
  461.  
  462.     mx = LBLLEN + ((*pexp=='=') ? 1 : 0) ;
  463.     while ((*pexp!=EOL)&&(*pexp!=' ')&&(*pexp!='\t')&&
  464.            (*pexp!=')')&&(*pexp!='\\'))
  465.     {
  466.         if (j<mx) label[j++] = *pexp ;
  467.         pexp++ ;
  468.     }
  469.     label[j] = EOL ;
  470.     plabel = label ;
  471.  
  472.     if ((val = symbol_value (label)) >= (saddr) 0)
  473.     {                             /* found, copy value */
  474.      
  475.         if (relabs==LREL) sprintf (label, "%ldr", val) ;
  476.         else sprintf (label, "%ld", val) ;
  477.     }
  478.     else if ((val == LBL_UDF) || (val == LBL_IVL))
  479.     {   /* UDF : label not (yet) declared, IVl : invalid label */
  480.         *plabel = EOL ;                /* incoherent value */
  481.         val = EXP_ERR ;
  482.     }
  483.     else if ((val == LBL_EXT) || (val == LBL_XEQ))
  484.     {   /* LBL_EXT: ext. label not known, LBL_XEQ: global defined with ext. */
  485.         val = EXP_EXT ;                        /* keep label name */
  486.     }
  487.     else                       /* (val == LBL_SEQ) */
  488.     {   /* LBL_SEQ : synonym, expandable */
  489.         plabel = xlabel ;              /* get definition of label */
  490.         need_par = 1 ;                 /* enclose label with (...) */
  491.         val = EXP_EXT ;                /* and store it into extep */
  492.     }
  493.  
  494.     if (need_par) append_extexp ("(") ;
  495.     append_extexp (plabel) ;
  496.     if (need_par) append_extexp (")") ;
  497.  
  498.     return (val) ;
  499. }
  500.  
  501.  
  502. /******************************************************************************
  503.  
  504.                                      APPLY
  505.  
  506.  
  507. synopsis : saddr apply (val1, op, val2, relabs1, relabs2)
  508.            saddr val1, val2
  509.            uchar op, relabs1, relabs2
  510. description : calculate the value of binary operator op applied to operands
  511.               val1 & val2.
  512. note : under overflow condition, numbers are truncated to 20 bits.
  513.  
  514. ******************************************************************************/
  515.  
  516. saddr apply (val1, op, val2, relabs1, relabs2)
  517. uchar op, relabs1, relabs2 ;
  518. saddr val1, val2 ;
  519. {
  520.     saddr val ;
  521.  
  522.     if (val2==EXP_ERR)                    return (EXP_ERR) ;
  523.     if ((val1==EXP_EXT)||(val2==EXP_EXT)) return (EXP_EXT) ;
  524.  
  525.     switch (op)
  526.     {
  527.         case '+' :
  528.             val = trunc (val1 + val2) ;
  529.             break ;
  530.         case '-' :
  531.             val = trunc (val1 - val2 ) ;
  532.             break ;
  533.         case '*' :
  534.             val = trunc (val1 * val2 ) ;
  535.             break ;
  536.         case '/' :
  537. #if ASSEMBLER
  538.             val = (val2 ? val1 / val2 : EXP_ERR ) ;
  539. #else
  540.             val = (val2 ? val1 / val2 : EXP_EXT ) ;
  541. #endif
  542.             if (val2==0L)   error (WRNNUL, "") ;   /* null divisor */
  543.             break ;
  544.         case '&' :
  545.             val = val1 & val2 ;
  546.             break ;
  547.         case '!' :
  548.             val = val1 | val2 ;
  549.             break ;
  550.         case '~' :
  551.             val = trunc (val1*256 + val2) ;
  552.             break ;
  553.         case '^' :
  554.             if ((val1<0)||(val2<0)||((val1==0)&&(val2==0)))
  555.             {
  556.                 error (WRNIXP, "") ;           /* Illegal exponentiation */
  557. #if ASSEMLER
  558.                 val = EXP_ERR ;
  559. #else
  560.                 val = EXP_EXT ;
  561. #endif
  562.             }
  563.             else
  564.             {
  565.                 val = 1 ;
  566.                 for (;val2>0 ; val2--) val *= val1 ;
  567.                 val = trunc (val) ;
  568.             }
  569.             break ;
  570.     }
  571.     if ((relabs1==LUDF)||(relabs2==LUDF))      relabs = LUDF ;
  572.     else if ((relabs1==LREL)||(relabs2==LREL)) relabs = LREL ;
  573.     else                                       relabs = LABS ;
  574.     return (val) ;
  575. }
  576.  
  577.  
  578. /******************************************************************************
  579.  
  580.                                      TRUNC
  581.  
  582.  
  583. synopsis : saddr trunc (val)
  584.            saddr val
  585. description : truncates 32 bits integer to 24 bits.
  586.  
  587. ******************************************************************************/
  588.  
  589. saddr trunc (val)
  590. saddr val ;
  591. {
  592.     return (val & 0xffffff) ;
  593. }
  594.  
  595.  
  596. /******************************************************************************
  597.  
  598.                                    NEXT_CHAR
  599.  
  600.  
  601. synopsis : void next_char ()
  602. description : stores the current character in extexp variable, and moves the
  603.               expression pointer (pexp) forward one position.
  604.  
  605. ******************************************************************************/
  606. void next_char ()
  607. {
  608.     *pextexp = *pexp ;
  609.     pextexp++ ;
  610.     pexp++ ;
  611. }
  612.  
  613.  
  614. /******************************************************************************
  615.  
  616.                                  APPEND_EXTEXP
  617.  
  618.  
  619. synopsis : void append_extexp (line)
  620.            uchar *line ;
  621. description : append line to extexp string.
  622.  
  623. ******************************************************************************/
  624.  
  625. void append_extexp (line)
  626. uchar *line ;
  627. {
  628.     while (*line)
  629.     {
  630.         *pextexp = *line ;
  631.         pextexp++ ;
  632.         line++ ;
  633.     }
  634. }
  635.